home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / doslbs.zip / DOSLIB02.CLA < prev    next >
Text File  |  1994-02-12  |  13KB  |  206 lines
  1.  
  2.                 MEMBER('DOSLIB')
  3. OMIT('╝')
  4. ╔════════════════════════════════════════════════════════════════════════════╗
  5. ║   TEMP01.CLA - Internal Source Module          !                           ║
  6. ╚════════════════════════════════════════════════════════════════════════════╝
  7.  
  8. Get_Filename     Function(DefaultMask,DefaultHeading)
  9.  
  10. Directory        STRING(64)
  11. ReturnFile       STRING(64)
  12. FileMask         STRING(12)
  13. DirQueue         QUEUE
  14. DirLine            STRING(15)
  15.                  .
  16. FileQueue        QUEUE
  17. FileLine           STRING(13)
  18.                  .
  19. SCREEN           SCREEN(17,50),PRE(SCR),SHADOW,EXPAND(9),FALL,CUA,COLOR(112)
  20.                    !dimensions=25,80,25,80
  21.                    !style=D:\CLARION\DEVELOP\DOSLIB\CLARION.STY
  22.                    ROW(1,1)    STRING('█{5}'),COLOR(3)
  23.                      COL(46)   STRING('█{5}'),COLOR(3)
  24.                    ROW(4,4)    STRING('Directory:'),COLOR(113)
  25.                    ROW(17,1)   STRING('█▄{48}█'),COLOR(3)
  26.                                REPEAT(15)
  27.                    ROW(2,1)      STRING('█'),COLOR(3)
  28.                    ROW(2,50)     STRING('█'),COLOR(3)
  29.                                .
  30. ScreenTitle        ROW(1,6)    STRING(@s40),COLOR(2)
  31.                    ROW(3,4)    PROMPT('File&name :'),COLOR(4,5,40,6,7)
  32.                      COL(14)   ENTRY(@s12),USE(FileMask),IMM,UPR,OVR,COLOR(8,9,38)
  33.                    ROW(4,14)   ENTRY(@s30),USE(Directory),SKIP,COLOR(8,9,38)
  34.                    ROW(6,4)    PROMPT('&Files'),COLOR(4,5,40,6,7)
  35.                    ROW(8,4)    LIST(8,14),FROM(FileLine),VSCROLL,USE(?FileList),IMM,COLOR(21,22,68)
  36.                    ROW(6,20)   PROMPT('Directories'),COLOR(4,5,40,6,7)
  37.                    ROW(8,20)   LIST(8,14),FROM(DirLine),VSCROLL,USE(?DirList),IMM,COLOR(21,22,68)
  38.                    ROW(9,38)   BUTTON('   &Ok   |'),SHADOW,USE(?OK),COLOR(17,18,39,19,20)
  39.                    ROW(12,38)  BUTTON(' &Cancel |'),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(17,18,39,19,20)
  40.                  .
  41. DirString   CSTRING(64)                          ! Used for Directory to search
  42. SaveDir     LIKE(DirString)                      ! Used to hold beginning path
  43. SaveSelect  LONG                                 ! Used to hold selected field
  44. DirInfo     GROUP                                ! Necessary DOS file group
  45.               BYTE,DIM(21)                       ! Used by findfirst
  46. Attrib        BYTE                               ! Attribute in DOS format
  47. DosTime       SHORT                              ! Time in DOS format
  48. DosDate       SHORT                              ! Date in DOS format
  49. Filesize      LONG                               ! Size in BYTES
  50. FileName      CSTRING(13)                        ! File name
  51.             END                                  ! End GROUP
  52. DriveNumber USHORT                               ! Used for Drive search
  53. CheckReady  STRING(3)                            ! Used to check if Drive is ready
  54.   CODE                                           ! Begin Processing Code
  55.   OPEN(SCREEN)                                   ! Open the screen
  56.   If Omitted(2) then
  57.      Scr:ScreenTitle = Center('Select a File',Size(Scr:ScreenTitle))
  58.   Else
  59.      Scr:ScreenTitle = Center(DefaultHeading,Size(Scr:ScreenTitle))
  60.   .
  61.   If ~Omitted(1) then
  62.      FileMask = DefaultMask                      !Set Default Filemask
  63.   .
  64.   If Clip(FileMask) = '' then FileMask = '*.*'.  !Set the begining file mask
  65.   SaveDir = PATH()                               !Save the Starting Directory
  66.   IF SUB(SaveDir,LEN(CLIP(SaveDir)),1) <> '\'    ! Last character not backslash?
  67.     SaveDir = CLIP(SaveDir) & '\'                ! Add the trailing '\'
  68.   END
  69.   Directory = SaveDir                            !Set to the Current Directory
  70.   DO FillQueues                                  !Fill the screen queues
  71.   LOOP                                           !Main ACCEPT loop
  72.     CASE SELECTED()                              ! Jump to field setup routine
  73.     END                                          ! End CASE
  74.     ACCEPT                                       ! ACCEPT keyboard input
  75.     CASE FIELD()                                 ! Jump to field edit routine
  76.     OF ?FileMask                                 ! Completed file mask field
  77.       IF REFER()                                 !  If something was entered
  78.         Do FillQueues                            !   Fill queues with new mask
  79.       END                                        !  End IF
  80.     OF ?FileList                                 ! FileList field edit
  81.       GET(FileQueue,CHOICE())                    !  Get selected file entry
  82.       IF KEYCODE() = MouseLeft2 OR |             !  On mouse double click
  83.          KEYCODE() = EnterKey                    !    Or the Enter Key
  84.         SELECT(?OK)                              !   Select the OK button and
  85.         PRESS(EnterKey)                          !   Press Enter to complete
  86.       END                                        !  End IF
  87.     OF ?DirList                                  ! Directory list field edit
  88.       IF SELECTED() = ?DirList                   !  If staying on this field
  89.         IF KEYCODE() = MouseLeft2 OR |           !   On mouse double click
  90.            KEYCODE() = EnterKey                  !     or the Enter Key
  91.           GET(DirQueue,CHOICE())                 !    Get the selected entry
  92.           IF LEN(CLIP(DirLine)) = 5 AND |        !  Are we looking at a drive?
  93.             SUB(DirLine,1,2) = '[-' AND |
  94.             SUB(DirLine,4,2) = '-]' AND |
  95.             SUB(DirLine,3,1) >= 'A' AND |
  96.             SUB(DirLine,3,1) <= 'Z'
  97.             CheckReady = SUB(DirLine,3,1) & ':'  ! Specify drive letter designation
  98.             IF STATUS(CheckReady) = 0            ! If drive not ready
  99.               CYCLE                              !   Don't change to it
  100.             END
  101.             Directory = CLIP(CheckReady)         ! Assign drive letter as new directory
  102.           ELSE
  103.             Directory = CLIP(Directory) & DirLine ! Create a new directory string
  104.           END
  105.           IF SUB(Directory,LEN(CLIP(Directory)),1) = '\' ! Last character a backslash?
  106.             Directory = SUB(Directory,1,LEN(CLIP(Directory))-1) ! Get rid of it before SETPATH
  107.           END
  108.           SETPATH(Directory)                     ! Set to current directory
  109.           Directory = PATH()                     ! Reread the current directory
  110.           IF SUB(Directory,LEN(CLIP(Directory)),1) <> '\' ! Last character not backslash?
  111.             Directory = CLIP(Directory) & '\'    ! Add the trailing '\' for display
  112.           END
  113.           Do FillQueues                          !    Fill the screen queues
  114.         END                                      !   End IF
  115.       END                                        !  End IF
  116.     OF ?Ok                                       ! Ok button field Edit
  117.       IF FileLine = '  NO MATCH     '            !  If no FileName selected
  118.         SELECT(?DirList)                         !   Select directory list
  119.         CYCLE                                    !   Cycle to ACCEPT.
  120.       END                                        !  End IF
  121.       ReturnFile = CLIP(Directory) & FileLine    ! Save the Filename
  122.       DO ProcedureReturn                         ! And leave the Procedure
  123.     OF ?Cancel                                   ! Cancel button field Edit
  124.       SETPATH(SaveDir)                           !  Return to starting path
  125.       FREE(DirQueue)                             !  Free the DirQueue memory
  126.       FREE(FileQueue)                            !  Free the FileQueue memory
  127.       CLEAR(ReturnFile)                          !  Clear the filename variable
  128.       DO ProcedureReturn                         ! And leave the Procedure
  129.     END                                          ! End CASE FIELD()
  130.   END                                            ! End LOOP
  131.   DO ProcedureReturn                             ! And leave the Procedure
  132. !─────────────────────────────────────────────────────────────────────────────
  133. ProcedureReturn ROUTINE                          ! return from the PROC
  134.   SETPATH(SaveDir)                               !Return to starting path
  135.   FREE(DirQueue)                                 !Free the DirQueue memory
  136.   FREE(FileQueue)                                !Free the FileQueue memory
  137.   DO EndOfProcedureEmbed                         ! Process the final EMBED
  138.   RETURN(ReturnFile)                             ! END exit the PROC
  139. !─────────────────────────────────────────────────────────────────────────────
  140. EndOfProcedureEmbed ROUTINE                      ! Process the final EMBED
  141. !─────────────────────────────────────────────────────────────────────────────
  142. !─────────────────────────────────────────────────────────────────────────────
  143. FillQueues ROUTINE
  144.   SaveSelect = SELECTED()                        !Save the current selected field
  145.   FREE(FileQueue)                                !Free the FileQueue
  146.   SELECT(?FileList,1)                            !Reset file list box
  147.   FREE(DirQueue)                                 !Free the DirQueue
  148.   SELECT(?DirList,1)                             !Reset Dir List box
  149.   DirString = CLIP(Directory) & '*.*'            !Set the subdirectory mask
  150.   IF NOT LEN(CLIP(DirString)) = 6                !If not in the root directory
  151.     DirLine = '..\'                              ! Make prior directory entry
  152.     ADD(DirQueue)                                ! Add to the DirQueue
  153.   END                                            !End IF
  154.   IF DL:FindFirst(DirString,DirInfo,FA_DIREC) <> 0 !If unexpected error
  155.     FREE(DirQueue)                               ! Clear the DirQueue
  156.     FREE(FileQueue)                              ! Clear the FileQueue
  157.     DISPLAY                                      ! Redisplay the lists
  158.     RETURN('')                                   ! Return
  159.   END                                            !End IF
  160.   LOOP                                           !While entries found
  161.     IF FileName = '.' OR FileName = '..'         ! If the dot entries
  162.       IF DL:FindNext(DirInfo) <> 0               !  Get the next entry
  163.         BREAK                                    !   Break if unexpected error
  164.       END                                        !  End IF
  165.       CYCLE                                      !  Return to dot entry check
  166.     END                                          ! End IF
  167.     IF BAND(ATTRIB,10H)                          ! If a subdirectory is found
  168.       DirLine = FileName                         !  Fill the queue field
  169.       ADD(DirQueue)                              !  Add to the DirQueue
  170.       IF ERRORCODE() THEN BREAK.                 !  Break if unexpected error
  171.     END                                          ! End IF
  172.     IF DL:FindNext(DirInfo) <> 0                 ! Get the next entry
  173.       BREAK                                      !  Break if unexpected error
  174.     END                                          ! End IF
  175.   END                                            !End LOOP
  176.   SORT(DirQueue,+DirLine)                        !Sort the directory listing
  177.   LOOP DriveNumber = 1 TO 26                     !Loop through drive numbers
  178.     IF DL:IsAValidDrive(DriveNumber)             !Validate drive number
  179.        DirLine = '[-' & CLIP(CHR(DriveNumber-1+VAL('A'))) & '-]' !Format drive letter
  180.        ADD(DirQueue)                             ! Add to the DirQueue
  181.     END
  182.   END
  183.   FileLine = 'Searching...'                      !Search message
  184.   ADD(FileQueue)                                 !Add to the FileQueue
  185.   DISPLAY                                        !Display new directory and message
  186.   FREE(FileQueue)                                !Free the FileQueue
  187.   DirString=CLIP(Directory) & FileMask           !Set the file mask
  188.   IF DL:FindFirst(DirString,DirInfo,FA_NORMAL) <> 0 !If no matching files found
  189.     FileLine = '  NO MATCH  '                    ! Fill queue with message
  190.     ADD(FileQueue)                               ! Add to the FileQueue
  191.   Else                                           !Else matching file found
  192.     LOOP                                         ! While entries are found
  193.       IF BAND(ATTRIB,10H) = 0                    !  If entry is a file
  194.         FileLine = FileName                      !   Fill the queue field and
  195.         ADD(FileQueue)                           !   Add to the FileQueue
  196.         IF ERRORCODE() THEN BREAK.               !   Break if unexpected error
  197.       END                                        !  End IF
  198.       IF DL:FindNext(DirInfo) <> 0               !  Get the next entry
  199.         BREAK                                    !   Break if unexpected error
  200.       END                                        !  End IF
  201.     END                                          ! End LOOP
  202.   END                                            !End IF
  203.   SORT(FileQueue,+FileLine)                      !Sort the file listing
  204.   DISPLAY                                        !Display the new lists
  205.   SELECT(SaveSelect)                             !Reselect the previous selected field
  206.